home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 17 / Hot Mix 17.iso / HM17_SGI / research / lib / write_bmp.pro < prev    next >
Text File  |  1997-07-08  |  7KB  |  218 lines
  1. ; $Id: write_bmp.pro,v 1.9 1997/01/15 03:11:50 ali Exp $
  2. ;
  3. ; Copyright (c) 1993-1997, Research Systems, Inc.  All rights reserved.
  4. ;    Unauthorized reproduction prohibited.
  5.  
  6. PRO WRITE_BMP, File, Image, Red, Green, Blue, $
  7.     FOUR_BIT = four_bit, Ihdr = Ihdr, HEADER_DEFINE = h
  8. ; Copyright (c) 1993, Research Systems, Inc.  All rights reserved.
  9. ;    Unauthorized reproduction prohibited.
  10. ;+
  11. ; NAME:
  12. ;    WRITE_BMP
  13. ;
  14. ; PURPOSE:
  15. ;       This procedure writes a Microsoft Windows Version 3 device
  16. ;    independent bitmap file (.BMP).
  17. ;
  18. ; CATEGORY:
  19. ;       Input/Output.
  20. ;
  21. ; CALLING SEQUENCE:
  22. ;       WRITE_BMP, File, Image [, R, G, B]
  23. ;
  24. ; INPUTS:
  25. ;       File:       The full path name of the bitmap file to write.
  26. ;       Image:       The array to write into the new bitmap file. The array
  27. ;            should be scaled into a range of bytes for 8 and 24
  28. ;           bit deep images. Scale to 0-15 for 4 bit deep images.
  29. ;              If the image has 3 dimensions and the first dimension
  30. ;           is 3, a 24 bit deep bitmap file is created.
  31. ;           NOTE: for 24 bit images, color interleaving is blue,
  32. ;           green, red: image[0,i,j] = blue, image[1,i,j] = green, etc.
  33. ;
  34. ; OPTIONAL INPUTS:
  35. ;       R, G, B:   Color tables. If omitted, the colors loaded in the
  36. ;           COLORS common block are used.
  37. ;
  38. ; KEYWORD PARAMETERS:
  39. ;       FOUR_BITS: Set this keyword to write as a four bit device
  40. ;             independent bitmap. If omitted or zero, an eight bit
  41. ;           deep map is written.
  42. ;       IHDR:       { BITMAPINFOHEADER } structure containing the file header
  43. ;              fields that are not obtained from the image parameter.
  44. ;              (The only fields that the user can set are:
  45. ;           bi{XY}PelsPerMeter, biClrUsed, and biClrImportant.)
  46. ;
  47. ; OUTPUTS:
  48. ;       No explicit outputs.
  49. ;
  50. ; KEYWORD OUTPUT PARAMETERS:
  51. ;       HEADER_DEFNIE: Returns an empty BITMAPINFOHEADER structure,
  52. ;               containing zeroes. No other actions are performed.
  53. ;               This structure may be then modified with the
  54. ;               pertinent fields and then passed in via the Ihdr
  55. ;                  keyword parameter. See the Microsoft Windows
  56. ;               Programmers Reference Guide for a description of
  57. ;               each field in the structure. NOTE: this parameter
  58. ;               must be defined before the call.  e.g.:
  59. ;                   h = 0
  60. ;                   WRITE_BMP, HEADER_DEFINE = h
  61. ;
  62. ; COMMON BLOCKS:
  63. ;       COLORS:    Used with 4- and 8-bit images if no colors are specified.
  64. ;
  65. ; SIDE EFFECTS:
  66. ;       IO is performed.
  67. ;
  68. ; RESTRICTIONS:
  69. ;       Does not handle 1-bit images or compressed images.
  70. ;       Is not fast for 4-bit images. Works best on images where the
  71. ;       number of bytes in each scan line is evenly divisible by 4.
  72. ;
  73. ; PROCEDURE:
  74. ;       Straightforward. Will work on both big endian and little endian
  75. ;    machines.
  76. ;
  77. ; EXAMPLES:
  78. ;       Pseudo screen dump from the current window:
  79. ;         WRITE_BMP, 'test.bmp', TVRD()
  80. ;
  81. ;       Scale an image to 0-15, and then write a four bit BMP file,
  82. ;       using a gray scale color table:
  83. ;         r = BYTSCL(INDGEN(16))   ;Ramp from 0 to 255.
  84. ;         WRITE_BMP, 'test.bmp', BYTSCL(Image, MAX=15), r, r, r, /FOUR
  85. ;
  86. ; MODIFICATION HISTORY:
  87. ;   DMS, RSI.   March 1993.    Original version.
  88. ;   DMS, RSI.   May, 1993.    Now works on all machines...
  89. ;-
  90.  
  91. common colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr
  92.  
  93.  
  94. on_ioerror, bad
  95. on_error, 2         ;Return on error
  96.  
  97.  
  98. if n_elements(ihdr) eq 0 then $         ;Define our header?
  99.   ihdr = { BITMAPINFOHEADER, $
  100.     bisize: 0L, $
  101.     biwidth: 0L, $
  102.     biheight: 0L, $
  103.     biplanes: 0, $
  104.     bibitcount: 0, $
  105.     bicompression: 0L, $
  106.     bisizeimage: 0L, $
  107.     bixpelspermeter: 0L, $
  108.     biypelspermeter: 0L, $
  109.     biclrused: 0L, $
  110.     biclrimportant: 0L $
  111.   } $
  112. else if tag_names(ihdr, /STRUCTURE_NAME) ne "BITMAPINFOHEADER" then $
  113.     message, 'IHDR must contain a BITMAPINFOHEADER structure'
  114.  
  115. if n_elements(h) gt 0 then begin
  116.     h = ihdr
  117.     return
  118.     endif
  119.  
  120. fhdr = { BITMAPFILEHEADER, $
  121.     bftype: bytarr(2), $        ;A two char string
  122.     bfsize: 0L, $
  123.     bfreserved1: 0, $
  124.     bfreserved2: 0, $
  125.     bfoffbits: 0L $
  126.   }
  127. s = size(image)
  128. if s[0] lt 2 then message,'Image parameter must have 2 or 3 dimensions.'
  129. nx = s[1]
  130. ny = s[2]
  131. if keyword_set(four_bit) then begin     ;4 bit image
  132.     ihdr.bibitcount = 4 
  133.     nc = 16
  134.     bperl = (nx + 1)/2                  ;bytes / line
  135. endif else if (s[0] eq 3) and (s[1] eq 3) then begin  ;True color
  136.     ihdr.bibitcount = 24
  137.     nx = ny
  138.     ny = s[3]
  139.     nc = 0
  140.     bperl = 3 * nx
  141. endif else begin                ;Plain 8 bit image
  142.     ihdr.bibitcount = 8
  143.     nc = 256
  144.     bperl = nx
  145. endelse
  146.  
  147. padded = (bperl + 3) and (not 3)   ;padded length
  148. if padded ne bperl then pad = bytarr(padded - bperl)
  149.  
  150. fhdr.bftype = byte("BM")
  151. ihdr.bisize = 40        ;Init some fields, size of info header
  152.  
  153. ;                filehdr   ihdr          colors  
  154. fhdr.bfoffbits = 14L +     ihdr.bisize + 4 * nc   ;Data start
  155. ihdr.bisizeimage = padded * ny              ;bytes in image part
  156. fhdr.bfsize = fhdr.bfoffbits + ihdr.bisizeimage  ;Total bytes in file
  157. ihdr.biwidth = nx
  158. ihdr.biheight = ny
  159. ihdr.biplanes = 1
  160. ihdr.bicompression = 0          ;For BI_RGB
  161.  
  162. openw, unit, file, /GET_LUN, /BLOCK
  163. if (byte(1,0,2))[0] eq 0b then $    ;Big endian machine
  164.   writeu, unit, swap_endian(fhdr), swap_endian(ihdr) $  ;Swap bytes
  165. else writeu, unit, fhdr, ihdr           ;Write the file and info headers
  166.  
  167. if nc ne 0 then begin               ;Pseudo color?
  168.     colors = bytarr(nc, 4)          ;Transposed color array
  169.     if n_elements(red) le 0 then begin  ;Get current color table?
  170.         if n_elements(r_curr) eq 0 then loadct,0, /silent  ;Fake it
  171.         n = (nc < n_elements(r_curr))-1     ;# of colors to take
  172.         colors[0,2] = r_curr[0:n]
  173.         colors[0,1] = g_curr[0:n]
  174.         colors[0,0] = b_curr[0:n]
  175.     endif else begin                ;Parameters passed in
  176.         n = (nc < n_elements(red)) -1  ;# of colors to take
  177.         colors[0,2] = red[0:n]
  178.         colors[0,1] = green[0:n]
  179.         colors[0,0] = blue[0:n]
  180.     endelse
  181.     writeu, unit, transpose(colors)  ;Write colors
  182.     endif
  183.  
  184. if ihdr.bibitcount eq 4 then begin  ;4 bits/pixel?
  185.     if padded ne bperl then pad = bytarr(padded - bperl)
  186.     even = lindgen(nx/2) * 2
  187.     odd = even + 1
  188.     for i=0, ny-1 do begin
  189.         buff = ishft(byte(image[even, i]), 4) + $
  190.         (byte(image[odd,i]) and 15b) ;combine
  191.         if (nx and 7) eq 0 then writeu, unit, buff $  ;No messing?
  192.         else if nx and 1 then begin         ;Odd # of columns?
  193.             t = ishft(byte(image[nx-1, i]), 4)       ;Last byte
  194.             if n_elements(pad) ne 0 then writeu, unit, buff, t, pad $
  195.             else writeu, unit, buff, t
  196.         endif else writeu, unit, buff, pad  ;Even, but add padding
  197.         endfor
  198. endif else if ihdr.bibitcount eq 8 then begin          ;8 bits/pixel?
  199.     if n_elements(pad) eq 0 then writeu, unit, byte(image) $     ;Slam dunk it
  200.     else begin                      ;Must write line by line...
  201.        for i=0, ny-1 do writeu, unit, byte(image[*,i]), pad  ;Write each line
  202.     endelse
  203. endif else begin                    ;24 bits / pixel....
  204.     if n_elements(pad) eq 0 then writeu, unit, byte(image) $  ;Again, dunk it.
  205.     else begin
  206.         for i=0, ny-1 do writeu, unit, byte(image[*,*,i]), pad
  207.     endelse
  208. endelse
  209.  
  210. free_lun, unit                  ;All done
  211. return
  212.  
  213. bad:  if n_elements(unit) gt 0 then free_lun, unit
  214. Message, 'Error writing BMP file: ' + file
  215. return
  216. end
  217.  
  218.